perm filename PANGLE.SAI[AER,HPM] blob sn#210452 filedate 1976-04-10 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "PANGLE"
C00006 ENDMK
C⊗;
BEGIN "PANGLE"
REAL JJN,JIN,JCN, IJN,IIN,ICN, JD,ID,CD, D;
STRING INP,OUP;
INTEGER PSIZ;
REQUIRE "PIXHDR.SAI[VIS,HPM]" SOURCE_FILE;

PROCEDURE INVPERSPECTIVE(REAL CX,CY,CZ,X0,Y0,Z0);
   BEGIN
   REAL A11,A12,A13,A21,A22,A23,A31,A32,A33;
   REAL W,CW,SW;
   W←SQRT(CX↑2+CY↑2+CZ↑2);
   IF W≠0 THEN
      BEGIN  CX←CX/W; CY←CY/W; CZ←CZ/W;  END
   ELSE
      BEGIN  CX←1; CY←0; CZ←0;  END;

   SW←SIN(W);  CW←COS(W);

   A11← (1 - CW)*CX*CX +  CW   ;
   A21← (1 - CW)*CY*CX - CZ*SW ;
   A31← (1 - CW)*CZ*CX + CY*SW ;

   A12← (1 - CW)*CX*CY + CZ*SW ;
   A22← (1 - CW)*CY*CY +  CW   ;
   A32← (1 - CW)*CZ*CY - CX*SW ;

   A13← (1 - CW)*CX*CZ - CY*SW ;
   A23← (1 - CW)*CY*CZ + CX*SW ;
   A33← (1 - CW)*CZ*CZ +  CW   ;

   JJN←          - A32*Y0 + A22*Z0 ;
   JIN←   A32*X0          - A12*Z0 ;
   JCN←  -A22*X0 + A12*Y0          ;

   IJN←            A31*Y0 - A21*Z0 ;
   IIN←  -A31*X0          + A11*Z0 ;
   ICN←   A21*X0 - A11*Y0          ;

   JD←   A21*A32 - A22*A31 ;
   ID←   A12*A31 - A11*A32 ;
   CD←   A11*A22 - A12*A21 ;

   END;




DO OUTSTR("INPUT FILE:") UNTIL (PSIZ←PFLDIM(INP←INCHWL))>0;
OUTSTR("OUTPUT FILE:"); OUP←INCHWL;

   BEGIN
   INTEGER ARRAY IP[0:PSIZ],OP[0:PIXDIM(480,512,9)];
   STRING S;  INTEGER I,J;

   PROCEDURE DEPOSIT(REAL CX,CY,CZ, PX,PY,PZ, D);
      BEGIN
      INTEGER H,W,B,HH,WW;
 
      INVPERSPECTIVE(CX,CY,CZ, PX,PY,PZ);

      H←IP[PCLN];  W←IP[LNBY];

      HH←H ASH -1;
      WW←W ASH -1;

      H←H-1;
      W←W-1;

      FOR I←0 STEP 1 UNTIL H DO
      FOR J←0 STEP 1 UNTIL W DO
         BEGIN
         REAL IT,JT,II,JJ,T;
         JT←J-WW; IT←I-HH;  JT←JT/D; IT←IT/D;
         T ← (JD*JT + ID*IT + CD);
         JJ← (JT*JJN + IT*JIN + JCN)/T + WW;
         II← (JT*IJN + IT*IIN + ICN)/T + HH;
         IF II≥0∧II≤H∧JJ≥0∧JJ≤W THEN
         PUTEL(OP[0],I,J,PIXEL(IP[0],II,JJ));
         END;

      END;

   GETPFL(INP,IP[0]);
   MAKPIX(IP[PCLN],IP[LNBY],IP[BYBI],OP[0]);

   DEPOSIT(.2,.8,-.1,0,0,300,400);

   PUTPFL(OP[0],OUP);
   END;

END;